PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/zipper.com/ZIPPER.PAS

Pascal/Delphi Source File | 1989-05-02 | 10.2 KB | 484 lines

{*****************************************************************************

   ZIPPER.PAS/TPU, overly simplified routines for manipulating central
   directory entrys within ZIP files.

   All routines public domain May 2, 1989, written by Tom Guinther except
   for SeekLong() which was kludged by Tom Guinther.

*****************************************************************************}




{$I-}

Unit Zipper;


Interface


{$IFDEF EXTRA}
Uses
 TpString;



Const

  BufSize = $0400; { 1k, This const is used by SeekLong }


{ Types used by SeekLong }

Type

  pBufferType = ^BufferType;
  BufferType  = Array[1..BufSize] of Byte;

{$ENDIF}



Const

  _LOCALFILESIG_      = $04034b50;
  _CENTRALDIRSIG_     = $02014b50;
  _ENDCENTRALDIRSIG_  = $06054b50;



Type

  zFile = File;   { Untype }


  pCentralDir = ^CentralDirRec;
  pZipDir     = ^ZipDirRec;


  GeneralInfo = Record   { Information common to local/central entrys }

           VersionToExtract,
           GPBiteFlag,
           CompMethod,
           FTime,
           FDate               : Word;

           CRC_32,
           CompSize,
           UnCompSize          : LongInt;

           FnameLen,
           ExFieldLen          : Word;



  End;


  LocalFileRec  = Record

            Signature : LongInt;
            FileInfo  : GeneralInfo;

  End;


  CentralDirRec = Record

           Signature           : LongInt;
           VersionMadeBy       : Word;        { Not included in genral info! }

           FileInfo            : GeneralInfo;

           FcommentLen         : Word;

           DiskNumStart,
           InternalFAttr       : Word;
           ExternalFAttr       : LongInt;

           RelOfsLocalHdr      : LongInt;

  End;


  ZipDirRec = Record

        pCD      : pCentralDir;
        pVar     : Pointer;
        pVarSize : LongInt;

  End;



Function  FindCentralDirectory(Var F : zFile) : LongInt;
Function  OpenZip(VAR F : zFile; Name : String) : Boolean;
Function  ReadCentralDirEntry(Var F : zFile; pZip : pZipDir ) : Boolean;
Procedure FreeZipRec(pZ : pZipDir);
Function  MakeFileName(pZ : pZipDir) : String;


Implementation


{$F+}
Function HeapFunc(Size : Word) : Integer;
Begin

  HeapFunc := 1;

End;
{$F-}



Function GetMemCheck(var P; Bytes : Word) : Boolean;
Var
  SaveHeapError : Pointer;
  Pt            : Pointer absolute P;

Begin

  SaveHeapError := HeapError; { Take over heap error control }
  HeapError     := @HeapFunc;

  GetMem(Pt, Bytes);
  GetMemCheck   := (Pt <> nil);

  HeapError := SaveHeapError; { Restore heap error control   }

End;



{ Avoid freeing a NIL pointer }

Procedure FreeMemCheck(P : Pointer; Size : Word);
Begin

     If P <> NIL Then
       FreeMem(P,Size);

End;



{*****************************************************************************

  SeekCentralDir:

    This function scans a ZIP file looking for the central directory.

    It assumes that a series of local file headers/files precedes the
    central directory. It uses the information contained in the local
    file header to move the file pointer past the actual file contents.
    This speeds up the I/O processing immensely.

*****************************************************************************}

Function SeekCentralDir(VAR F : zFile) : Boolean;
Var
 CurPos  : LongInt;
 Buf     : LocalFileRec;
 IOError : Integer;
 Result  : word;

Begin

        SeekCentralDir := False;

        CurPos := 0;
        Seek(F,0);

        BlockRead(F,Buf,SizeOf(LocalFileRec),Result);

        IOError := IOResult;

        While (IOError = 0) and (Buf.Signature = _LOCALFILESIG_) Do
        Begin


            With Buf, FileInfo Do
              CurPos := FilePos(F)+FNameLen+ExFieldLen+CompSize;

            Seek(F,CurPos);

            BlockRead(F,Buf,SizeOf(LocalFileRec),Result);

            IOError := IOResult;

        End;

        If IOError <> 0 Then
          Exit;

        If (Buf.Signature = _CENTRALDIRSIG_) Then
        Begin

            SeekCentralDir := True;
            Seek(F,CurPos);          { Rewind back size of local header }

        End;

End;


{$IFDEF EXTRA}

{****************************************************************************

   SeekLong:  This function attempts to find a long integer within the
              file F. A buffer of BufSize is used to speed up I/O
              operations. The last 3 bytes of the I/O buffer *must* be
              saved (they couldn't be compared since the length of a LongInt
              is > 3 bytes). This means that all reads after the initial read
              are of the size bufSize-3.

              This function uses the Search Function from Turbo Professional
              4/5, but you could easily replace it with one of your own.


******************************************************************************}

Function SeekLong(VAR F : zFile; L : LongInt) : Boolean;
Var
  Buf    : pBufferType;
  Result : Word;
  Ofs1   : LongInt;
  OfsX   : Word;
  Done   : Boolean;

Begin

        SeekLong := False;
        Done     := False;
        Ofs1     := 0;

        If NOT GetMemCheck(Buf,SizeOf(BufferType)) Then
           Exit;

    Blockread(F,Buf^,BufSize,result);  { initial read }

        If (IoResult <> 0) Then
         Done := True;

    while NOT Done Do
        Begin

            OfsX := Search(Buf^,BufSize,L,SizeOf(LongInt));

            If OfsX = $FFFF Then
            Begin

               Ofs1 := Ofs1 + BufSize-3;
               Move(Buf^[BufSize-3],Buf^[1],3);

               If Eof(F) Then
                 Done := True
               Else
               Begin

                 BlockRead(F,Buf^[4],BufSize-3,Result);

                 If IoResult <> 0 Then
                   Done := True;

               End

            End
            Else
            Begin

              Done     := True;
              SeekLong := True;
              Ofs1     := Ofs1 + OfsX;

              Seek(F,Ofs1);   { Rewind back to where we found L }

            End;

        End;

        FreeMemCheck(Buf,BufSize);

End;

{$ENDIF}



{*****************************************************************************

  FindCentralDirectory:

   This function uses SeekCentralDir to position the file pointer to the
   start of the central directory. If the central Directory is not found
   it returns 0, otherwise it returns the offset of the central directory.

*****************************************************************************}

Function FindCentralDirectory(Var F : zFile) : LongInt;
Begin

       If SeekCentralDir(F) Then
            FindCentralDirectory := FilePos(F)
       Else
            FindCentralDirectory := 0;

End;



{*****************************************************************************

  OpenZip: This routine opens F (a zFile, untyped) with a record size of 1.
           F is opened in read/only mode. This function returns false if
           it cannot open the file.

*****************************************************************************}

Function OpenZip(VAR F : zFile; Name : String) : Boolean;
Begin

        Assign(F,Name);

        If IoResult <> 0 Then
          Exit;

        Reset(F,1);

        Openzip := IoResult = 0;

End;



{*****************************************************************************

  ReadCentralDirectory:

   This function reads the current central directory entry, allocating
   memory for the data structures. Each directory entry has a variable
   length data area, which makes it almost impossible to use a static
   data structure to hold an entry. This routine will return false if
   an I/O error occurs or it cannot allocate enough memory to hold the
   data.

*****************************************************************************}

Function ReadCentralDirEntry(Var F : zFile; pZip : pZipDir ) : Boolean;
Var
  Result : Word;
  VSize  : LongInt;
  Vptr   : Pointer;
  pL     : Pointer;

Begin

        ReadCentralDirEntry := False;

        If NOT GetMemCheck(pZip^.pCD,SizeOf(CentralDirRec)) Then
            Exit;

        BlockRead(F,pZip^.pCD^,SizeOf(CentralDirRec),Result);

        If (IoResult <> 0) or (Result <> SizeOf(CentralDirRec)) Then
           Exit;

        pL := pZip^.pCD;

        If LongInt(pL^) <> _CENTRALDIRSIG_ Then
          Exit;  { Item is NOT a central directory entry }

        With pZip^, pCD^, FileInfo do
        Begin

           { Calculate size of variable data area }

           VSize := FnameLen + ExFieldLen + FCommentLen;

           If NOT GetMemCheck(Vptr,Vsize) Then
             Exit;

           BlockRead(F,Vptr^,Vsize,Result);

           If (IoResult <> 0) or (Result <> Vsize) Then
             Exit;

           pZip^.pVar     := Vptr;
           pZip^.pVarSize := VSize;

        End;

        ReadCentralDirEntry := True;

End;



{*****************************************************************************

   FreeZipRec: This function will free a dynamically allocated central
               directory entry.


*****************************************************************************}

Procedure FreeZipRec(pZ : pZipDir);
Begin

     If pZ = NIL Then Exit;

     With pZ^ Do
     Begin

          { Free the central directory record }

          FreeMemCheck(pCD,SizeOf(CentralDirRec));

          { Free The variable length field(s) }

          FreeMemCheck(pVar,SizeOf(pVarSize));

     End;

End;



{*****************************************************************************

   MakeFileName:

      This function converts a central directory file name into an LString.

*****************************************************************************}

Function MakeFileName(pZ : pZipDir) : String;
Var
  Tmp : String;

Begin

   With pZ^, pCD^, FileInfo Do
   Begin

     Tmp[0] := Char(ShortInt(FileInfo.FnameLen));

     Move(pVar^,Tmp[1],FileInfo.FnameLen);

   End;

   MakeFileName := Tmp;

End;



End.  { Implementation }